Power Programmierung/Power-Programmierung (Tewi)(1994).iso/magazine/drdobbs/1987/07/lindlst.jul

Text File | 1987-07-28 | 22KB | 918 lines

{$K-}             {Compiler switch - never change}

{************************************************}
{***                 Listing One              ***}
{***                Turbo Pascal              ***}
{***            Multitasking Kernel           ***}
{***                 written by               ***}
{***              Craig A. Lindley            ***}
{***                                          ***}
{***    Ver: 1.3     Last update: 03/11/87    ***}
{***                                          ***}
{************************************************}

CONST

   task_stack_size  = 256; {stack size for each}
                           {task}
   turbodseg: integer = 0; {storage for turbos}
                           {data segment value}


TYPE

{possible states for a task}
   task_state = (ready,waiting,running);

{808X register set}
   register_type = RECORD
   CASE integer OF
      1: (ax,bx,cx,dx,bp,si,di,ds,es,flags:integer);
      2: (al,ah,bl,bh,cl,ch,dl,dh         :byte);
   END;


{Task control block (tcb) structure}

 tcbptr = ^ tcb;       {ptr to tcb}

 tcb = RECORD
    link:  tcbptr;     {link to next tcb in dseg}
    bptr:  integer;    {base ptr offset in sseg}
    state: task_state; {ready, waiting, running}
    id:    byte;       {task number}
 END;

 waitptr = ^tcbptr;    {ptr to ptr to tcb}
                       {used for passing parms}
                       {to wait}

{This fifo overhead structure is the same for}
{all fifo types regardless of the items to be}
{stored in the fifo. The byte fifo is an example}
{of just one possible type of fifo.}

 overhead = RECORD     {fifo overhead data}
                       {structure}
    count,             {# of items in fifo}
    inptr,             {ptr to where items are}
                       {stored}
    outptr:   integer; {ptr to where items are}
                       {fetched}
    not_empty,         {ptrs to waiting tasks}
    not_full: tcbptr;
 END;


 bytefifo = RECORD     {definition of a byte fifo}
    ovd:  overhead;    {fifo overhead}
    data: ARRAY[1..bytefifosize]
           OF byte;    {byte fifo data area}
 END;


 semaphore = RECORD    {Semaphore data type}
    count:  integer;   {number of times signaled}
    signal: tcbptr;    {pointer to waiting task}
                       {if there is one}
 END;


{******** Begin Multitasking Variables *********}

VAR

   cp,                  {current task pointer}
   new_tcb_ptr,         {ptr to new tcb in dseg}
   temp_ptr:   tcbptr;

   waitfor:    waitptr; {address of item to}
                        {wait on}
   stk,bp:     integer; {variables for setting}
                        {808X sp and bp}
   frame_ptr:  integer; {stack frame pointer}
   next_id:    integer; {next task id number}
   i:          integer;
   child_process: boolean; {fork successful flag}


{******** Begin Multitasking Procedures ********}


PROCEDURE Fork;        {fork off a new task}

{This procedure manipulates Turbo Pascal's stack}
{frame as required to fool it into operating in}
{a new task's environment.}

BEGIN

   child_process:=false;   {indicate the parent}
                           {process until proven}
                           {otherwise}
   {check if enough stack space for a new task}

   IF abs(frame_ptr - task_stack_size) > 0 THEN
   BEGIN                   {if enough}
      INLINE($89/$26/stk); {get 808X Sp to}
                           {calculate Bp pointer}
      cp^.bptr:=stk+2;     {save Bp ptr in this}
                           {frame}
      new(new_tcb_ptr);    {allociate new tcb}

      {link new tcb into scheduler loop}
      {make its state running and give it an id}

      new_tcb_ptr^.link:=cp^.link;
      cp^.link:=new_tcb_ptr;
      new_tcb_ptr^.state:=running;
      next_id:=next_id+1;
      new_tcb_ptr^.id:=next_id;

      cp^.state:=ready;    {old frame is ready}

      {copy old stack to new stack frame}
      FOR i:=0 TO 5 DO
         mem[sseg:frame_ptr-6+i]:=mem[sseg:stk+i];

      {make Bp storage in stack frame point at}
      {this frame}

      memw[sseg:frame_ptr-4]:=frame_ptr;
      bp:=frame_ptr-4;     {calculate Bp pointer}

      INLINE($8B/$2E/bp);  {set 808X Bp reg to}
                           {this new value}

     {reserve stack frame space}
     frame_ptr:=frame_ptr-task_stack_size;
     cp:=new_tcb_ptr;      {cp points at new task}
     child_process:=true;  {indicate child process}
   END;

END;



PROCEDURE Yield;

{This procedure cause the executing task to}
{relinquish control of the CPU to the next ready}
{task.}

BEGIN

   child_process:=false;   {reset variable}
   IF cp^.link <> cp THEN  {must have more than}
                           {one task forked to be}
                           {able to yield}
   BEGIN
      INLINE($89/$26/stk); {get 808X sp}
      cp^.bptr:=stk+2;     {save Bp ptr in}
                           {current task frame}
      cp^.state:=ready;    {yielded task ready}
      temp_ptr:=cp;

      {look for next ready task in scheduler loop}
      {there must be at least one or else}

      WHILE (temp_ptr^.link^.state <> ready) DO
         temp_ptr:=temp_ptr^.link;

      cp:=temp_ptr^.link;  {cp points at new task}
      cp^.state:=running;  {indicate running}
      bp:=cp^.bptr;        {get the bp of task}

     INLINE($8B/$2E/bp);   {restore it to 808X bp}
   END
   ELSE
   BEGIN
      writeln('Cannot yield only single task running');
      halt;
   END;

END;



PROCEDURE Wait;  {put current task in wait mode}
                 {until a send makes it ready}

{Due to constraints of this kernel, parameters}
{cannot be passed directly to the wait procedure.}
{To overcome this limitation, a global variable}
{called waitfor is used. The address of the}
{tcbptr on which to wait should be stored in}
{waitfor. See the fifo routines for an example of}
{the proper usage of Wait.}

BEGIN

   child_process:=false;   {reset variable}
   IF cp^.link <> cp THEN  {must have more than}
                           {one task forked to be}
                           {able to wait}
   BEGIN
      waitfor^ := cp;      {waitfor points at the}
                           {current task}

      INLINE($89/$26/stk); {get 808X sp}
      cp^.bptr:=stk+2;     {save it in current}
                           {task frame}
      cp^.state:=waiting;  {task now waiting}
      temp_ptr:=cp;

      {look for next ready task in scheduler loop}
      {there must be at least one or else}

      WHILE (temp_ptr^.link^.state <> ready) DO
         temp_ptr:=temp_ptr^.link;

      cp:=temp_ptr^.link;  {cp points at new task}
      cp^.state:=running;  {indicate running}
      bp:=cp^.bptr;        {get bp for this task}
      INLINE($8B/$2E/bp);  {restore it to 808X bp}
   END
   ELSE
   BEGIN
      writeln('Cannot wait only single task running');
      halt;
   END;

END;


PROCEDURE Send(VAR s:tcbptr);

{Make the specified task ready for next scheduler}
{go around}

BEGIN

   s^.state:=ready;    {task state is ready}
   s:=NIL;             {clear pointer}

END;



PROCEDURE Pause(t:integer);

{Pause the execution of a task for t 1/4 sec}
{intervals. Note even t results in more}
{accurate timmings.}

 FUNCTION tic_count : integer;

 {Get the current tic count from the Bios}

 VAR

    regs: register_type;

 BEGIN

    regs.ax:=0;         {request clock tic read}
    intr($1A,regs);
    tic_count:=regs.dx; {LSB of count in dx}

 END;


VAR

   tics,i: integer;

BEGIN

   tics:=0;             {initial tic count to 0}
   IF t > 0 THEN        {if a legal tic count}
   BEGIN
      FOR i:=1 TO t DO  {250 msec = 4.55 tics}
         IF odd(i) THEN {use this algorithm for}
                        {approximation}
            tics:=tics+4 {250 msec = 4.5 tics}
         ELSE
            tics:=tics+5;

      {add tics to current tic_count to get}
      tics:=tics+tic_count;    {target time}

      REPEAT
         yield;    {return when tic count is}
                   {reached or exceeded}
      UNTIL tics <= tic_count;
   END
   ELSE
      writeln('Bad tic count specified');

END;


PROCEDURE Init_Kernel;

{This procedure initializes the multitasking}
{for use. It sets up the TCB for task 0 and}
{indicates that it is running.}

Begin

   turbodseg:=dseg;     {save turbo data segment}
   frame_ptr:= $FFFE;   {initial stack location}
   next_id:=0;          {first task id}
   new(new_tcb_ptr);    {get new tcb in dseg}
   cp:=new_tcb_ptr;     {cp points at tcb}
   cp^.link:=cp;        {points at itself}
   cp^.state:=running;  {in running state}
   cp^.id:=next_id;     {id = 0}

   {now allociate 1st frame for task 0}
   frame_ptr:=frame_ptr-task_stack_size;

End;


{************ Begin FIFO Procedures ************}


PROCEDURE Initialize_fifo(VAR o:overhead);

{Initialize a fifo's overhead data structure.}
{This procedure will work with any type fifo.}
{This makes the fifo appear empty.}

BEGIN

   o.count:= 0;        {count is empty}
   o.inptr:=1;         {ptrs to 1st entry}
   o.outptr:=1;        {put in and take out at}
                       {entry 1}
   o.not_empty:=NIL;   {signals to nil}
   o.not_full:=NIL;

END;


PROCEDURE Put_byte(b:byte; VAR f:bytefifo);

{This procedure manages the input of data into}
{a byte fifo. If the fifo is full when this}
{procedure is called, the task that called it}
{will be put to sleep automatically until there}
{is room in the fifo for the data byte.}
{The fifo overhead data structure is modified}
{whenever a byte is placed into the fifo}

BEGIN

   WITH f.ovd DO
   BEGIN                {check if fifo full}
      IF count = bytefifosize THEN
      BEGIN             {if so go to sleep}
         waitfor := addr (not_full);
         wait;
      END;              {when not full add}
      count:=count+1;   {one more to count}
      f.data[inptr]:=b; {store the byte}
      inptr:=inptr+1;   {bump input pointer}
      IF inptr > bytefifosize THEN
         inptr:=1;      {wrap ptr if necessary}

      {if waiters for this fifo wake them}

      IF not_empty <> NIL THEN
         send(not_empty);
   END;

END;


FUNCTION Get_byte(VAR f:bytefifo) : byte;

{This procedure manages the output of data from}
{a byte fifo. If the fifo is empty when this}
{procedure is called, the task that called it}
{will be put to sleep automatically until there}
{is data in the fifo to retrieve.}
{The fifo overhead data structure is modified}
{whenever a byte is removed from the fifo}

BEGIN

   WITH f.ovd DO
   BEGIN               {check if fifo empty}
      IF count = 0 THEN
      BEGIN            {if so go to sleep}
         waitfor := addr (not_empty);
         wait;
      END;
                       {when data is available}
      count:=count-1;  {one less to count}
      get_byte:=f.data[outptr];  {get the byte}
      outptr:=outptr+1;{bump output pointer}
      IF outptr > bytefifosize THEN
         outptr:=1;    {wrap ptr if necessary}

      {if waiters for this fifo wake them}

      IF not_full <> NIL THEN
         send(not_full);
   END;

END;


{********* Begin Semaphore Procedures **********}

PROCEDURE Initialize_semaphore(VAR s:semaphore);

{Initialize a semaphore data structure}

BEGIN

   s.count := 0;       {indicate resource is}
                       {available}
   s.signal:=NIL;      {and that there are no}
                       {waiters}

END;



PROCEDURE Alloc(VAR s:semaphore);

{This procedure allociates exclusive use of a}
{resource to the task that executes it. This}
{claim is maintained even though the task}
{gives up control of the CPU via a yield etc.}

BEGIN

   WHILE s.count <> 0 DO  {wait for semaphore}
                          {controlled resource}
                          {to become available}
   BEGIN
      waitfor := addr (s.signal);
      wait;
   END;                   {then}
   s.count:=1;            {claim it}

END;


PROCEDURE Dealloc(VAR s:semaphore);

{This procedure deallociates a resource.}
{Note this routine yields so the deallociated}
{resource has a chance of being used}
{immediately}

BEGIN

   s.count:=0;     {remove claim on resource}
   send(s.signal); {and awaken the waiting task}
   yield;          {give other tasks a chance}

END;

{End of kernel procedures}





PROGRAM Multitasking_Demonstration_Program;

{************************************************}
{***                Listing Two               ***}
{***        Multitasking Demonstration        ***}
{***         A dumb terminal program          ***}
{*** utilizing 4 tasks and a serial interrupt ***}
{***              service routine.            ***}
{***                                          ***}
{***                 written by               ***}
{***              Craig A. Lindley            ***}
{***                                          ***}
{***    Ver: 1.0     Last update: 03/11/87    ***}
{***                                          ***}
{************************************************}

CONST

 bytefifosize = 100;    {max size of byte fifos}


{include the multitasking kernel routines}
{$I multi.pas}

{include the RS-232 functions}
{$I serial.pas}


VAR

   inbuffer,
   outbuffer:     bytefifo;


{***** Serial Interface Support Procedures *****}

PROCEDURE Get_serial_char;

VAR

   b:   byte;

BEGIN

{Get the character from the UART. Place it in}
{inbuffer if there is room, throw it away if}
{not. Signal end of interrupt (EOI level 4 on}
{8259.}

   b := port[portaddress];

   IF inbuffer.ovd.count < bytefifosize THEN
      Put_byte(b,inbuffer);

   port[$20] := $20;

END;



PROCEDURE Serial_Interrupt_Service_Routine;

{This is the new interrupt service routine.}
{It replaces the one MsDos normally uses.}
{See text for details.}

BEGIN

{standard interrupt service routine preamble}

 INLINE($50/$53/$51/$52/$57/   {Push ax,bx,cx,dx,}
        $56/$06/$1e/           {di,si,es,ds}
        $2e/$a1/turbodseg/     {mov ax,cs:turbodseg}
        $8e/$d8/               {mov ds,ax}
        $fb);                  {sti}

 Get_serial_char;

 {standard interrupt service routine postamble}

 INLINE($fa/$1f/$07/$5e/$5f/   {interrupts off}
        $5a/$59/$5b/$58/       {Pop ds,es,si,di,}
                               {dx,cx,bx,ax}
        $5d/$5d/$cf);          {trash sp, restore}
                               {Bp and iret}

END;


{************ Begin Task Procedures ************}


PROCEDURE Task_0;

{Task 0 gets keyboard input and puts it into}
{outbuffer. If no input available task 0 yields.}
{Note infinite loop structure.}

VAR

   ch:    char;

BEGIN

   writeln('Starting Task 0');
   writeln;
   REPEAT
      IF NOT keypressed THEN
         Yield
      ELSE
      BEGIN
         read(kbd,ch);
         Put_byte(byte(ch),outbuffer);
      END;
   UNTIL false;

END;


PROCEDURE Task_1;

{Task 1 takes character from outbuffer using}
{Get_Byte and sends them out the serial port.}

BEGIN

   writeln('Starting Task 1');
   REPEAT
      Serialout(Get_byte(outbuffer));
   UNTIL false;

END;


PROCEDURE Task_2;

{Task 2 retrives characters placed in inbuffer}
{by the serial interrupt routine and displays}
{them on the screen. Note:}
{ 1) If no characters are available this routine}
{    yields.
{ 2) Interrupts must be disabled while inbuffer}
{    is being accessed. Otherwise the fifo}
{    counter will get confused and this program}
{    will eventually crash.}


BEGIN

   writeln('Starting Task 2');
   REPEAT

      IF inbuffer.ovd.count <> 0 THEN
      BEGIN
         INLINE($FA);   {interrupts off}
         write(chr(Get_byte(inbuffer)));
         INLINE($FB);   {interrupts on }
      END
      ELSE
         Yield;

   UNTIL false;

END;


PROCEDURE Task_3;

{Task 3 monitors and displays the fifo and cursor}
{status. It wakes up every 1/2 second to do so.}
{The cursor position is saved and retrived while}
{the fifo status is being updated on the screen}

VAR

   cursorx,
   cursory: byte;

BEGIN

   writeln('Starting Task 3');
   REPEAT
      pause(2);          {wake every 1/2 sec}
      cursorx := wherex; {save cursor position}
      cursory := wherey;
      window(1,1,80,25);
      gotoxy(21,25);
      write(cursorx:2);  {write cursor position}
      gotoxy(35,25);
      write(cursory:2);
      gotoxy(58,25);     {write fifo counts}
      write(inbuffer.ovd.count:2);
      gotoxy(72,25);
      write(outbuffer.ovd.count:2);
      window(1,1,80,23);
      gotoxy(cursorx,cursory);
   UNTIL false;

END;


PROCEDURE Initialize_Display;

{This procedure initializes the screen for the}
{demo program. It builds a status line on screen}
{line 25 and then establishes a terminal window}
{so the status line will not be over written.}

BEGIN

   window(1,1,80,25);   {window is full screen}
   CLRSCR;              {clear the screen}

   writeln('Multitasking Demonstration');
   writeln('  A dumb serial terminal program');
   writeln('  Use ^C to abort');
   writeln;

   {build the status line}
   gotoxy( 1,25);  write('Status -- Cursor X:');
   gotoxy(25,25);  write('Cursor Y:');
   gotoxy(49,25);  write('Incount:');
   gotoxy(62,25);  write('Outcount:');
   window(1,1,80,23);   {establish terminal window}
   gotoxy(1,8);         {home the cursor}

END;


{************* Begin Main Program **************}

BEGIN {main}

{The main program builds the screen status}
{line, initializes the input and output fifos,}
{initializes the multitasking kernel, installs}
{the serial interrupt handler and then begins}
{forking the individual tasks.}

   Initialize_Display;
   Initialize_fifo(inbuffer.ovd);
   Initialize_fifo(outbuffer.ovd);
   Init_Kernel;

{Initialize and install the serial interrupt}
{handler. Install our interrupt routine in}
{place of the original system IRQ4 handler}

   WITH regs DO
   BEGIN
      ah:=$25;
      al:=$0C;
      ds:=cseg;
      dx:=ofs(Serial_Interrupt_Service_Routine);
      msdos(regs);
   END;

{Set the serial format to 1200 baud}
{1 stop bit, 8 data bits and no parity}

 Setserial(1200,1,8,none);

{Fork off tasks one through three}

 Fork;

 IF child_process THEN
  Task_1;

 Fork;

 IF child_process THEN
   Task_2;

 Fork;

 IF child_process THEN
   Task_3;

{Enable the serial interrupt}

 Enable_serial_int;

{Start Task 0}

 Task_0;

END.






{************************************************}
{***               Listing Three              ***}
{***        Multitasking Demonstration        ***}
{***             support routines             ***}
{***                                          ***}
{***                 written by               ***}
{***              Craig A. Lindley            ***}
{***                                          ***}
{***    Ver: 1.0     Last update: 03/11/87    ***}
{***                                          ***}
{************************************************}

CONST

   COM1        = 1;      {com one PC port}
   portaddress = $3f8;   {address of UART for}
                         {COM1}

TYPE

   parity_type = (odd,even,none);

VAR

   regs:   register_type;


PROCEDURE Int14(portnumber,command,
                parameter:integer);

{Procedure to initialize the com ports}

BEGIN

   WITH regs DO
   BEGIN
      dx := portnumber - 1;
      ah := command;
      al := parameter;
      flags := 0;
      intr($14,regs);
   END;

END;


PROCEDURE Setserial(baudrate,stopbits,
                    databits: integer;
                    parity: parity_type);

{Configure COM1 with the specified parameters}

VAR

    parameter: integer;

BEGIN

   writeln('Configuring the serial parameters');
   writeln;
   CASE baudrate OF
      300: baudrate := 2;
     1200: baudrate := 4;
      ELSE baudrate := 4;  {default is 1200 baud}
   END;

   IF stopbits = 2 THEN
      stopbits := 1
   ELSE
      stopbits := 0;       {default is 1 stop bit}

   IF databits = 7 THEN
      databits := 2
   ELSE
      databits := 3;       {default is 8 bit words}

   parameter := (baudrate SHL 5)+
                (stopbits SHL 2)+databits;

   CASE parity OF
      odd: parameter := parameter + 8;
     even: parameter := parameter + 24;
     none: ;
   END;

   Int14(COM1,0,parameter);{do the configuration}

END;


FUNCTION Serialstatus : integer;

{Get the status of COM1 port}

BEGIN

   Int14(COM1,3,0);
   serialstatus := regs.ax;

END;


PROCEDURE Serialout(b:byte);

{Send a byte out the COM1 port}

BEGIN

   {wait till UART is ready}
   WHILE (Serialstatus AND $2000) = 0 DO;

   {then send the byte out}
   port[portaddress] := b;

END;



PROCEDURE Enable_serial_int;

BEGIN

{clear the serial interface of any garbage}

 INLINE($BA/portaddress  /$EC/
        $BA/portaddress+5/$EC/
        $BA/portaddress+6/$EC);

 INLINE($E4/$21/$24/$EF/$E6/$21); {IRQ4 enabled}
 port[portaddress+4] := $0B;      {set DTR, RTS}
                                  {and OUT2}
 port[portaddress+1] := 1;        {receiver}
                                  {interrupt}
                                  {enabled}
END;

{End of RS-232 procedures}